|||||||||||||||||||||||||||||||| ||| This space not dedicated ||| |||||||||||||||||||||||||||||||| ( utilities: memory dump: ?PR, etc. ) FORTH DEFINITIONS DECIMAL MYSEG VARIABLE SEGMENT ( base segment for FETCH ) : NTIMES BASE @ 4 MAX ; ( -- n # locations to be displayed ) : FETCH SEGMENT @ SWAP LC@ ; ( offset -- n ) : ?NL 1+ NTIMES MOD 0= ; ( -- f start new line ? ) : FWIDTH ( -- n field width for printing; depends on base ) BASE @ CASE 16 OF 3 ENDOF 10 OF 4 ENDOF 8 OF 4 ENDOF 2 OF 9 ENDOF ( default case ) 16 BASE ! 3 SWAP ENDCASE ; : ?PR ( n -- f tf if n is printable ) 127 AND DUP 127 < OVER 31 > AND ; : (D#) DUP NTIMES + SWAP DO ( addr -- dump numbers ) I ?NL IF LEAVE ENDIF I FETCH FWIDTH .R LOOP ; --> ( utilities: memory dump: DUMP ) : (DC) DUP NTIMES + SWAP DO ( addr -- dump chars ) I ?NL IF LEAVE ENDIF I FETCH ?PR IF EMIT ELSE DROP 46 EMIT ENDIF LOOP ; ( -- print SEGMENT if not FORTH ) : SEG. SEGMENT @ MYSEG = 0= IF SEGMENT @ 0 5 D.R THEN 58 EMIT ; : DUMP ( n -- n2 : display contents from n to n2-1 ) 8 0 DO CR DUP DUP DUP SEG. 0 5 D.R SPACE ( address ) (D#) SPACE SPACE ( numbers ) (DC) ( chars ) DUP NTIMES MOD NTIMES SWAP - + LOOP ; ;S ( utilities: DEPTH S? VOC? BASE? ) FORTH DEFINITIONS DECIMAL ( -- n depth of stack ) : DEPTH SP@ S0 @ SWAP - 2 / 0 MAX ; ( -- non-destructive stack display ) : S? DEPTH IF SP@ S0 @ 2- DO I ? -2 +LOOP ELSE ." empty " ENDIF ; : VOC. 4 - NFA ID. ; ( addr -- print vocabulary id. ) ( -- print CURRENT and CONTEXT ID ) : VOC? CURRENT @ CONTEXT @ 2DUP = IF ." CURRENT and CONTEXT are " VOC. DROP ELSE ." CONTEXT is " VOC. ." , CURRENT is " VOC. THEN 3 SPACES ; ( -- show current base in decimal ) : BASE? BASE @ DUP DECIMAL . BASE ! ; ;S ( utilities: SIZE? NEW ) FORTH DEFINITIONS DECIMAL ( -- show current length of FORTH dictionary and remaining free space ) : SIZE? HERE 0 +ORIGIN - 0 6 D.R ." bytes used, " S0 @ HERE - 0 6 D.R ." bytes free " ; ( -- update start-up parameters to reflect FORTH's current state ) : NEW CR ." current version is " 10 +ORIGIN C@ 65 + EMIT CR ." new version (A-Z)? " KEY DUP EMIT 65 - 10 +ORIGIN C! ( user version ) [ ' FORTH 4 + ] LITERAL @ 12 +ORIGIN ! ( top of FORTH) R0 @ 6 + 18 +ORIGIN 16 CMOVE ; ( user variables ) ;S ( utilities: BUFS? ) FORTH DEFINITIONS HEX : .HEAD SPACE DUP 0< IF 2A EMIT ( * ) 7FFF AND ELSE BL EMIT ENDIF 5 .R ; : .TOP CR CR ." addr block contents" ; ( -- show state of block buffers ) : BUFS? .TOP FIRST #BUFF 0 DO CR DUP 0 5 HEX D.R DECIMAL ( buffer address ) DUP @ .HEAD ( block #, updated? ) DUP USE @ = IF ." <-USE " ELSE DUP PREV @ = IF ." <-PREV" ELSE 6 SPACES THEN THEN DUP 2+ 5 SPACES 28 TYPE ( print buffer's contents ) B/BUF 4 + + LOOP CR ." * = updated buffer " ; DECIMAL ;S ( utilities: DLIST, WORDS ) FORTH DEFINITIONS HEX : DLIST CR CR CR VLIST ; ( fig VLIST ) : MORE? DUP IF @ 0A081 = 0= ENDIF ; DECIMAL 10 VARIABLE TABSTOP : TAB BEGIN OUT @ TABSTOP @ MOD WHILE SPACE REPEAT ; : WORDS ( show context vocabulary, in columns ) CR CR CR VOC? 80 OUT ! CONTEXT @ @ BEGIN OUT @ C/L > IF CR 0 OUT ! THEN DUP MORE? WHILE DUP ID. TAB PFA LFA @ REPEAT DROP ; ;S ( Screen move utilities ) EDITOR DEFINITIONS DECIMAL ( n -- copy screen n to the current screen ) : GET SCR @ COPY ; ( n m -- GET m screens, beginning at n ) : GET# OVER + SWAP DO FORTH I EDITOR GET 1 SCR +! LOOP ; 234 CONSTANT SCR/DRIVE ( single density, 8" ) ( n m -- copy screen n on drive 0 to screen m on drive 1 ) : DCOPY DR0 SCR/DRIVE + COPY ; ( n -- copy screen n to the same screen on drive 1 ) : >DR1 DUP DCOPY ; : #>DR1 OVER + 1+ SWAP DO ( n m -- copy n-m) FORTH I EDITOR >DR1 LOOP ; FORTH DEFINITIONS ;S ( screen copy utility ) : ASSIGN-BUF ( n addr -- ;changes buffer-header at addr to n ) DUP SAVBUF SWAP 32768 + SWAP ! ; ( buffer is now updated! ) : SCRCOPY ( m n -- ;copies block m to n, but doesn't write n ) ( NOTE: if n is currently in a buffer this blows up) SWAP BLOCK 2- ASSIGN-BUF ; : #SCRCOPY ( from to n -- ;copy n blocks ) FLUSH ROT SWAP OVER + SWAP DO I OVER SCRCOPY 1+ LOOP DROP SAVE-BUFFERS ;
